home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / DEVSEL.for < prev    next >
Text File  |  1991-04-13  |  2KB  |  101 lines
  1.         SUBROUTINE DEVSEL(NEWDEV,LUN,IERR)
  2.     INTEGER NEWDEV,LUN,IERR
  3.         IMPLICIT NONE
  4. C
  5. C
  6.         INCLUDE DIGLIB$KOM:GCDSEL.PRM
  7.         INCLUDE DIGLIB$KOM:GCDPRM.PRM
  8.         INCLUDE DIGLIB$KOM:GCCPAR.PRM
  9.         INCLUDE DIGLIB$KOM:GCVPOS.PRM
  10.         INCLUDE DIGLIB$KOM:GCCPOS.PRM
  11.         INCLUDE DIGLIB$KOM:GCCLIP.PRM
  12.         INCLUDE DIGLIB$KOM:GCDCHR.PRM
  13.         INCLUDE DIGLIB$KOM:GCLTYP.PRM
  14.         
  15.         REAL*4 DEVCHR(8), GDCOMN(5), DUMMY
  16.         REAL*4 DFDIST(4,3),GOODCS,XCUR,YCUR
  17.         INTEGER I,J
  18. C
  19. C       DEFINE DEFAULT LINE STYLES
  20. C
  21.         EQUIVALENCE (DEVID,GDCOMN(1))
  22.         DATA DFDIST /
  23.      1    0.5,  0.5,  0.5,  0.5,
  24.      2   0.25, 0.25, 0.25, 0.25,
  25.      3    0.5, 0.25, 0.25, 0.25/
  26.         DATA DUMMY /0/
  27. C
  28. C       RELEASE CURRENT DEVICE
  29. C
  30.         IF (IDEV .NE. 0) CALL GSDRVR(6,DUMMY,DUMMY)
  31. C
  32. C       NOW INIT. THE NEW DEVICE
  33. C
  34.         IF (NEWDEV .LE. 0) GO TO 900
  35.         IDEV = NEWDEV
  36.  
  37. C
  38. C       INITIALIZE THE DEVICE FOR DIGLIB GRAPHICS
  39. C
  40.         CALL GSDRVR(1,FLOAT(LUN),DUMMY)
  41.         IERR = DUMMY
  42.         IF (IERR .NE. 0) GO TO 910
  43. C
  44. C       GET THE DEVICE CHARACTERISTICS 
  45. C
  46.         DEVCHR(8) = 1.0
  47.         CALL GSDRVR(7,DEVCHR,DUMMY)
  48.         IF (DEVCHR(1) .EQ. 0.0) GO TO 900
  49. C
  50. C       SET DEVICE CHARACTERISTICS FOR LATER USE
  51. C
  52.         DO 100 I=1,5
  53. 100     GDCOMN(I) = DEVCHR(I)
  54.     XLENCM = DEVCHR(2)
  55.     YLENCM = DEVCHR(3)
  56.     XRES   = DEVCHR(4)
  57.     YRES   = DEVCHR(5)
  58.         NDCLRS = DEVCHR(6)
  59.         IDVBTS = DEVCHR(7)
  60.         NFLINE = DEVCHR(8)
  61.         XCLIPD = XLENCM + 0.499/DEVCHR(4)
  62.         YCLIPD = YLENCM + 0.499/DEVCHR(5)
  63. C
  64. C       NOW INIT THE PARAMETERS
  65. C
  66.         XS = 1.0
  67.         YS = 1.0
  68.         XT = 0.0
  69.         YT = 0.0
  70.         RCOS = 1.0
  71.         RSIN = 0.0
  72.         CSIZE = GOODCS(0.3)
  73.         CCOS = 1.0
  74.         CSIN = 0.0
  75.         XCUR = 0.0
  76.         YCUR = 0.0
  77.         IVIS = 0
  78.         XCM0 = 0.0
  79.         YCM0 = 0.0
  80.         XCM1 = XCLIPD
  81.         YCM1 = YCLIPD
  82.         ILNTYP = 1
  83.                 DO 120 I=1,3
  84.                         DO 110 J=1,4
  85.                         DIST(J,I) = DFDIST(J,I)
  86. 110                     CONTINUE
  87. 120             CONTINUE
  88.         LCURNT = .FALSE.
  89.         RETURN
  90. C
  91. C       NON-EXISTANT DEVICE SELECTED, REPORT ERROR AND DESELECT DEVICE
  92. C
  93. 900     IERR = -1
  94. C
  95. C       DEVICE INITIALIZATION FAILED, DESELCT DEVICE
  96. C
  97. 910     IDEV = 0
  98.         RETURN
  99.         END
  100.  
  101.